home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Roland / Hilbert.mod < prev    next >
Text File  |  1995-03-07  |  3KB  |  160 lines
  1. (*************************** Hilbert curves ******************************)
  2.  
  3. (**************************************************************************
  4.  
  5.     MODUL
  6.       Hilbert.mod
  7.  
  8.     DESCRIPTION
  9.       Hilbertcurves from "Algorithmen und Datenstrukturen" (N. Wirth)
  10.  
  11.     NOTES
  12.       OS 2.0+
  13.  
  14.     BUGS
  15.  
  16.     TODO
  17.  
  18.     EXAMPLES
  19.  
  20.     SEE ALSO
  21.  
  22.     INDEX
  23.  
  24.     HISTORY
  25.       20-feb-95   Roland Jesse   created
  26.  
  27. ***************************************************************************)
  28.  
  29. <* STANDARD- *>             (* necessary for assignable cleanup procedure *)
  30.  
  31. MODULE Hilbert;
  32.  
  33. IMPORT
  34.   Dos, Kernel, gfx := Graphics, I := Intuition, SYS := SYSTEM, U := Utility;
  35.  
  36. CONST
  37.    n = 6; h0 = 256;
  38.    VersionStr = "$VER: Hilbert 1.1 (20.2.95)";
  39.  
  40. VAR
  41.    i, h, x, y, x0, y0 :  INTEGER;
  42.    ch : LONGINT;                                  (* only for Prog-End... *)
  43.    screen : I.ScreenPtr;
  44.  
  45. PROCEDURE ^ A(i: INTEGER);
  46. PROCEDURE ^ B(i: INTEGER);
  47. PROCEDURE ^ C(i: INTEGER);
  48. PROCEDURE ^ D(i: INTEGER);
  49.  
  50.  
  51. (*  EasyRequester at the end to wait for a user willing end... *)
  52. PROCEDURE Done;
  53. VAR
  54.    es : I.EasyStruct;
  55.    pushed : LONGINT;
  56.  
  57. BEGIN
  58.    es.structSize := SIZE (I.EasyStruct);
  59.    es.flags := {};
  60.    es.title := SYS.ADR ("Hilberts Turm");
  61.    es.textFormat := SYS.ADR ("Done.");
  62.    es.gadgetFormat := SYS.ADR ("Bye");
  63.  
  64.    pushed := I.EasyRequest ( NIL, SYS.ADR (es), NIL, NIL );
  65. END Done;
  66.  
  67.  
  68. (* opens the screen for drawing in it *)
  69. PROCEDURE InitBlatt;
  70. BEGIN
  71.    screen := NIL;
  72.    ASSERT (I.base.libNode.version >= 37, Dos.fail);
  73.    screen := I.OpenScreenTagsA ( NIL,
  74.       I.saTitle, SYS.ADR ("Hilbertcurves by =rj= in 1995"),
  75.       U.end );
  76.    ASSERT (screen # NIL, Dos.fail);
  77. END InitBlatt;
  78.  
  79.  
  80. (* remove all allocated stuff *)
  81. PROCEDURE* Cleanup (VAR rc : LONGINT);
  82. BEGIN
  83.    IF screen # NIL THEN I.OldCloseScreen (screen); END;
  84.    Kernel.RemoveTrapHandler
  85. END Cleanup;
  86.  
  87.  
  88. (* Draw a line from the actual position to (x,y) *)
  89. PROCEDURE Pinsel;
  90. BEGIN
  91.    gfx.Draw (SYS.ADR (screen.rastPort), x, y)
  92. END Pinsel;
  93.  
  94.  
  95. (* actual position := (x,y) *)
  96. PROCEDURE PosPinsel;
  97. BEGIN
  98.    gfx.Move (SYS.ADR (screen.rastPort), x, y)
  99. END PosPinsel;
  100.  
  101.  
  102. PROCEDURE A(i: INTEGER);
  103. BEGIN
  104.    IF i > 0 THEN
  105.       D(i-1); x := x-h; Pinsel;
  106.       A(i-1); y := y-h; Pinsel;
  107.       A(i-1); x := x+h; Pinsel;
  108.       B(i-1)
  109.    END
  110. END A;
  111.  
  112.  
  113. PROCEDURE B(i: INTEGER);
  114. BEGIN
  115.    IF i > 0 THEN
  116.       C(i-1); y := y+h; Pinsel;
  117.       B(i-1); x := x+h; Pinsel;
  118.       B(i-1); y := y-h; Pinsel;
  119.       A(i-1)
  120.    END
  121. END B;
  122.  
  123.  
  124. PROCEDURE C(i: INTEGER);
  125. BEGIN
  126.    IF i > 0 THEN
  127.       B(i-1); x := x+h; Pinsel;
  128.       C(i-1); y := y+h; Pinsel;
  129.       C(i-1); x := x-h; Pinsel;
  130.       D(i-1)
  131.    END
  132. END C;
  133.  
  134.  
  135. PROCEDURE D(i: INTEGER);
  136. BEGIN
  137.    IF i > 0 THEN
  138.       A(i-1); y := y-h; Pinsel;
  139.       D(i-1); x := x-h; Pinsel;
  140.       D(i-1); y := y+h; Pinsel;
  141.       C(i-1)
  142.    END
  143. END D;
  144.  
  145.  
  146. (* main *)
  147. BEGIN
  148.    Kernel.InstallTrapHandler;                  (* Oh, I like this ... ;o) *)
  149.    Kernel.SetCleanup (Cleanup);                          (* And this, too *)
  150.    InitBlatt;
  151.    i := 0; h := h0; x0 := h DIV 2; y0 := h DIV 2 + 11;
  152.    REPEAT
  153.       i := i+1; h := h DIV 2;
  154.       x0 := x0 + (h DIV 2); y0 := y0 + (h DIV 2);
  155.       x := x0; y := y0;
  156.       PosPinsel; A(i)
  157.    UNTIL i = n;
  158.    Done;
  159. END Hilbert.
  160.